REM >Director:Menus.System.ExpPath

REM This expands a path into a serious of menu entries
REM By Simon/SJM at Uniqway

REM Call with the Path variable to be expanded as the argument
REM eg "Dynamic:/Director:Menus.System.ExpPath C"
REM or "Dynamic:/Director:Menus.System.ExpPath System: .Modules"

REM 1.00 15/5/95 SJM Started
REM 1.01 23/5/95 SJM Fixed bug with Foo: path entries
REM 1.02 26/5/95 NCW Made it recurse in Foo:Bar entries also
REM                  Collapses paths as far as possible
REM 1.03 11/2/02 PJL Allowed a postfix for each element to be set
REM                  See the System: example above.

ON ERROR: ON ERROR OFF: ERROR ERR,REPORT$+" at "+STR$ ERL

REM set this to false if you don't want nested paths to be expanded also
allow_recurse=TRUE

debug=FALSE

XOS_Module=FNswi_number("XOS_Module")
Menu=FNswi_number("Director_Menu")
EndMenu=FNswi_number("Director_EndMenu")
Option=FNswi_number("Director_Option")
Command=FNswi_number("Director_Command")
Dash=FNswi_number("Director_Dash")
XOS_ReadVarVal=FNswi_number("XOS_ReadVarVal")
XOS_File%=FNswi_number("XOS_File")
XOS_FSControl%=FNswi_number("XOS_FSControl")

buffer_size%=1024
DIM buffer% buffer_size%

SYS"OS_GetEnv" TO A$

PROCskippast
WHILE RIGHT$(A$,1)=" " A$=LEFT$(A$):ENDWHILE
IF FNuc(LEFT$(A$,5))="-QUIT" THEN PROCskippast : PROCskippast
t%=INSTR(A$," ")
IF t%<>0 THEN
  path$=LEFT$(A$,t%-1)
  postfix$=MID$(A$,t%+1)
ELSE
path$=A$
  postfix$=""
ENDIF

title$=path$
IF FNreduce(path$, dir$, TRUE) THEN
  PROCmake_menu
  OSCLI"Set Director$Menu ExpandedPath"
ELSE
  path$+=dir$
  IF "." = RIGHT$(path$) THEN path$ = LEFT$(path$)
  OSCLI"Set Director$Menu Path:"+path$
ENDIF

END

DEF PROCmake_menu
  SYS Menu,""""+title$+""" ExpandedPath -temp"

  REPEAT
    comma%=INSTR(path$,",",1)
    IF comma% THEN
      IF comma% = 1 THEN
         element$=""
      ELSE
         element$=LEFT$(path$,comma%-1)
      ENDIF
      path$=MID$(path$,comma%+1)
    ELSE
      element$=path$
      path$=""
    ENDIF

    element$+=dir$
    IF element$="" THEN element$="@"

    recurse%=FNreduce(element$, edir$, FALSE)
    element$+=edir$
    IF allow_recurse=0 THEN recurse%=FALSE

    IF "." = RIGHT$(element$) THEN element$ = LEFT$(element$)
    IF recurse% THEN
      IF FNfileexists(element$+postfix$) THEN
        SYS Option,""""+element$+postfix$+""" -sub ""Dynamic:/Director:Menus.System.ExpPath "+element$+postfix$+""" -sprite small_path"
      ENDIF
    ELSE
      IF element$>" " THEN
        IF FNfileexists(element$+postfix$) THEN
          SYS Option,""""+FNleaf(element$)+""" -path "+FNcanon(element$+postfix$)+" -up"
        ENDIF
      ENDIF
    ENDIF

  UNTIL path$=""

  SYS EndMenu
ENDPROC

REM Returns TRUE if the file exists
DEF FNfileexists(file$):LOCAL o%
SYS XOS_File%,17,file$ TO o%
=(o%<>0)

DEF FNreduce(RETURN path$, RETURN dir$, all_the_way%)
LOCAL done%,p%,q%,var$,a$,more%
  dir$=""
  more%=FALSE
  REPEAT
    IF debug THEN SYS Option,"["+path$+dir$+"] -grey"
    done%=TRUE
    p%=INSTR(path$,":")
    IF p% THEN
      var$=FNread(LEFT$(path$,p%-1)+"$Path")
      IF var$<>"" THEN

        q%=INSTR(var$,",")
        IF q%=0 OR all_the_way% THEN
          a$=MID$(path$,p%+1)
          IF RIGHT$(a$)<>"." AND a$<>"" THEN a$+="."
          dir$=a$+dir$
          path$=var$
          IF RIGHT$(dir$)="." THEN dir$=LEFT$(dir$)
          IF q%=0 THEN done%=FALSE ELSE more%=TRUE
        ELSE
          more%=TRUE
        ENDIF

      ENDIF
    ENDIF
  UNTIL done%
=more%

DEF FNswi_number(name$)
  SYS "OS_SWINumberFromString",,name$ TO A%
=A%

DEF FN0(a%)
s$=""
WHILE ?a%<>0
 s$+=CHR$?a%
 a%+=1
ENDWHILE
=s$


DEF PROCskiptospace WHILE LEFT$(A$,1)<>" "ANDLEN A$<>0 A$=MID$(A$,2):ENDWHILE:ENDPROC
DEF PROCskipspace WHILE LEFT$(A$,1)=" " A$=MID$(A$,2):ENDWHILE:ENDPROC
DEF PROCskippast PROCskiptospace:PROCskipspace:ENDPROC

DEF FNuc(a$)
LOCAL Z%,z$,b$
FOR Z%=1TOLEN a$
z$=MID$(a$,Z%,1)
IF z$>="a"IF z$<="z" z$=CHR$(ASC z$-32)
b$+=z$:NEXT
=b$

DEF FNleaf(path$)
leaf$=""
FOR I=LEN path$ TO 1 STEP -1
  IF "." = MID$(path$,I,1) THEN =MID$(path$,I+1)
NEXT
=path$

DEF FNread(a$)
LOCAL read%,flags%
  ?buffer%=13
  SYS XOS_ReadVarVal,a$,buffer%,buffer_size%,0,3 TO ,,read%;flags%
  IF flags% AND 1 THEN read%=0
  buffer%?read%=13
=$buffer%

DEF FNcanon(a$)
REM =a$
SYS XOS_FSControl%,37,a$,buffer%,,,buffer_size%
=FNstring(buffer%)

DEF FNstring(ptr%):LOCAL a$:a$=""
WHILE ?ptr%>31
  a$+=CHR$(?ptr%):ptr%+=1
ENDWHILE:=a$
